home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / s / spiele / denk / wzcs / wzcs.lst < prev    next >
Encoding:
File List  |  1996-11-17  |  12.5 KB  |  505 lines
  1. '
  2. '
  3. '
  4. '          WOLFRAMS ZWEITES COMPUTERSPIEL   (W.Z.C.S.)
  5. '
  6. '
  7. '
  8. '
  9. '                  von Wolfram Rösler 27/7/88
  10. '
  11. '
  12. '
  13. '                  ==========================
  14. '                  Quellcode in GFA-Basic 2.0
  15. '                  ==========================
  16. '
  17. DEFLIST 0
  18. VOID FRE(0)
  19. '
  20. '                                                             Compiler-Optionen
  21. '
  22. OPTION BASE 1
  23. OPTION "B+"
  24. OPTION "E-"
  25. OPTION "T-"
  26. OPTION "U0"
  27. '
  28. '                                                    Bildschirm-Initialisierung
  29. '
  30. HIDEM
  31. DEFFILL 1,2,4
  32. PBOX 3,3,550,396
  33. GRAPHMODE 2
  34. DEFTEXT 1,16,0,32
  35. TEXT 10,33,"W.Z.C.S."
  36. DEFTEXT ,,900
  37. TEXT 580,396,399,"Wolframs Zweites ComputerSpiel"
  38. DEFTEXT ,,,13
  39. TEXT 610,396,396,"von Wolfram Rösler, Augustastr. 44-46, D-5100 Aachen"
  40. TEXT 630,396,396,"geschrieben 27.7.88 in GFA-Basic 2.0  -  public domain"
  41. DEFTEXT 1,0,0,13
  42. TEXT 5,195,"Grundmuster:"
  43. GRAPHMODE 1
  44. '
  45. '                               Variablen-Vorbelegung und Konstanten-Definition
  46. '
  47. DIM x%(4),y%(4),button%(@but.anz,4),balls%(4,8),ballx%(4,8),bally%(4,8),ordnung%(4,8)
  48. rad%=80                              ! Radius der 4 großen Räder
  49. brad%=61                             ! Radius, auf dem die Kugeln liegen
  50. grundmuster%=1                       ! aktuelles Grundmuster
  51. ercnt%=0                             ! Fehlerzähler
  52. intlen%=VARPTR(x%(2))-VARPTR(x%(1))  ! bytes pro Integer var.
  53. DEFFN but.anz=24                     ! Anzahl der Buttons
  54. '
  55. '                                                          Dateninitialisierung
  56. '
  57. ' Buttons  (crazy about buttons ? Call W-Germany 0241/529317 to rent a superb button machine)
  58. RESTORE buttons
  59. FOR j%=1 TO @but.anz
  60.   @make.button(j%)
  61. NEXT j%
  62. ' Rahmen um Grundmuster #1
  63. BOX button%(13,1)+2,button%(13,2)+2,button%(13,3)-2,button%(13,4)-2
  64. '
  65. ' Koordinaten der Räder
  66. RESTORE circ.coord
  67. FOR j%=1 TO 4
  68.   READ x%(j%),y%(j%)
  69. NEXT j%
  70. '
  71. ' Koordinaten der Bälle
  72. p45=PI*45
  73. p22.5=PI*22.5
  74. FOR j%=1 TO 4
  75.   FOR j1%=1 TO 8
  76.     ballx%(j%,j1%)=x%(j%)+SIN((p45*(j1%-1)-p22.5)/180)*brad%
  77.     bally%(j%,j1%)=y%(j%)+COS((p45*(j1%-1)-p22.5)/180)*brad%
  78.   NEXT j1%
  79. NEXT j%
  80. '
  81. ' Anfangsfarben der Kugeln
  82. @circ(j%)
  83. '
  84. ' Räder zeichnen
  85. @ball.init
  86. '
  87. '                                                                 Hauptschleife
  88. '
  89. SHOWM
  90. mainloop:
  91. ON ERROR GOSUB err
  92. DO
  93.   REPEAT
  94.     x%=MOUSEX
  95.     y%=MOUSEY
  96.   UNTIL MOUSEK<>0
  97.   @check.button
  98.   IF button%<>0 ! irgendwas angeklickt
  99.     IF button%<13 OR button%>20  ! Button außer Grundmuster 1-8
  100.       DEFFILL 1,1
  101.       GRAPHMODE 3
  102.       PBOX button%(button%,1),button%(button%,2),button%(button%,3),button%(button%,4)
  103.       GRAPHMODE 1
  104.     ENDIF
  105.     @do.it(button%)
  106.     IF button%<13 OR button%>20 ! Wie oben
  107.       DEFFILL 1,1
  108.       GRAPHMODE 3
  109.       PBOX button%(button%,1),button%(button%,2),button%(button%,3),button%(button%,4)
  110.       GRAPHMODE 1
  111.     ENDIF
  112.   ENDIF
  113. LOOP
  114. ' END ist in Proc. "do.it"
  115. '
  116. '                                                                    Prozeduren
  117. '
  118. PROCEDURE make.button(n%)  ! Buttons initialisieren
  119.   LOCAL x%,y%,l%,h%,a$
  120.   DEFFILL 0
  121.   READ x%,y%,l%,h%
  122.   button%(n%,1)=x%
  123.   button%(n%,2)=y%
  124.   button%(n%,3)=l%
  125.   button%(n%,4)=h%
  126.   PBOX x%,y%,l%,h%                      ! Bereich löschen
  127.   BOX x%,y%,l%,h%                       ! Rahmen
  128.   DRAW l%+1,y% TO l%+1,h%+1 TO x%,h%+1  ! Schatten
  129.   IF n%<=10  ! Pfeilbutton
  130.     READ x%,y%,l%,h%
  131.     DEFLINE 1,3,0,1
  132.     LINE x%,y%,l%,h%
  133.     DEFLINE 1,1,0,0
  134.   ELSE       ! Funktionsbutton
  135.     READ x%,y%,a$
  136.     TEXT x%,y%,57,a$
  137.   ENDIF
  138. RETURN
  139. PROCEDURE ball.init ! Initialisieren des Grundmusters
  140.   LOCAL j%
  141.   IF grundmuster%=1
  142.     RESTORE ball.col.1
  143.   ENDIF
  144.   IF grundmuster%=2
  145.     RESTORE ball.col.2
  146.   ENDIF
  147.   IF grundmuster%=3
  148.     RESTORE ball.col.3
  149.   ENDIF
  150.   IF grundmuster%=4
  151.     RESTORE ball.col.4
  152.   ENDIF
  153.   IF grundmuster%=5
  154.     RESTORE ball.col.5
  155.   ENDIF
  156.   IF grundmuster%=6
  157.     RESTORE ball.col.6
  158.   ENDIF
  159.   IF grundmuster%=7
  160.     RESTORE ball.col.7
  161.   ENDIF
  162.   IF grundmuster%=8
  163.     RESTORE ball.col.8
  164.   ENDIF
  165.   IF grundmuster%=9
  166.     RESTORE ball.col.9
  167.   ENDIF
  168.   FOR j%=1 TO 4
  169.     FOR j1%=1 TO 8
  170.       READ balls%(j%,j1%)
  171.     NEXT j1%
  172.   NEXT j%
  173.   BMOVE VARPTR(balls%(1,1)),VARPTR(ordnung%(1,1)),intlen%*DIM?(balls%())
  174.   CIRCLE 320,200,50  ! kleines Rad
  175.   FOR j%=1 TO 4
  176.     CIRCLE x%(j%),y%(j%),rad%   ! Umrißlinien der Räder
  177.     @balls(j%)                  ! Kugeln in die Räder
  178.   NEXT j%
  179. RETURN
  180. PROCEDURE circ(n%)    ! Rad # n% zeichnen
  181.   LOCAL j%
  182.   FOR j%=1 TO 4
  183.     DEFFILL 1,2,15
  184.     PCIRCLE x%(j%),y%(j%),rad% ! Bereich löschen
  185.     DEFFILL 0
  186.     PCIRCLE x%(j%),y%(j%),5    ! Nabenbereich löschen
  187.     CIRCLE x%(j%),y%(j%),5     ! Nabe zeichnen
  188.   NEXT j%
  189. RETURN
  190. PROCEDURE balls(m%)   ! Kugeln auf Rad # m% zeichnen
  191.   LOCAL j%
  192.   IF m%<5  ! große Räder
  193.     FOR j%=1 TO 8
  194.       DEFFILL 1,2,balls%(m%,j%)
  195.       PCIRCLE ballx%(m%,j%),bally%(m%,j%),10
  196.     NEXT j%
  197.   ELSE    ! kleines Rad
  198.     FOR j%=1 TO 2
  199.       DEFFILL 1,2,balls%(1,j%)
  200.       PCIRCLE ballx%(1,j%),bally%(1,j%),10
  201.       DEFFILL 1,2,balls%(3,j%+4)
  202.       PCIRCLE ballx%(3,j%+4),bally%(3,j%+4),10
  203.     NEXT j%
  204.   ENDIF
  205. RETURN
  206. PROCEDURE check.button  ! checken, ob und welcher Button gedrückt
  207.   LOCAL j%,a%,b%,c%,d%  ! x% und y% sind global (Mauskoord.)
  208.   button%=0  ! Rückgabevariable (global)
  209.   FOR j%=1 TO @but.anz
  210.     a%=button%(j%,1)
  211.     b%=button%(j%,2)
  212.     c%=button%(j%,3)
  213.     d%=button%(j%,4)
  214.     IF x%>=a% AND y%>=b% AND x%<=c% AND y%<=d%
  215.       button%=j%
  216.     ENDIF
  217.   NEXT j%
  218. RETURN
  219. PROCEDURE do.it(b%)  ! b%: Nr. des gedrückten Buttons
  220.   LOCAL j%,s%,n%,f$
  221.   IF b%<9  ! senkrechte Pfeile
  222.     IF b% MOD 2=0  ! nach rechts drehen
  223.       n%=b%/2
  224.       s%=balls%(n%,1)
  225.       FOR j%=1 TO 7
  226.         balls%(n%,j%)=balls%(n%,j%+1)
  227.       NEXT j%
  228.       balls%(n%,8)=s%
  229.       @adept(n%)
  230.       @balls(n%)
  231.     ELSE          ! nach links drehen
  232.       n%=(b%+1)/2
  233.       s%=balls%(n%,8)
  234.       FOR j%=8 DOWNTO 2
  235.         balls%(n%,j%)=balls%(n%,j%-1)
  236.       NEXT j%
  237.       balls%(n%,1)=s%
  238.       @adept(n%)
  239.       @balls(n%)
  240.     ENDIF
  241.   ELSE
  242.     ' Inneren Kreis drehen
  243.     IF b%=9  ! nach rechts
  244.       s%=balls%(1,2)
  245.       balls%(1,2)=balls%(1,1)
  246.       balls%(1,1)=balls%(4,3)
  247.       balls%(3,6)=balls%(3,5)
  248.       balls%(3,5)=s%
  249.       @adept(1)
  250.       @adept(3)
  251.       @balls(5)
  252.     ENDIF
  253.     IF b%=10 ! nach links
  254.       s%=balls%(1,1)
  255.       balls%(1,1)=balls%(1,2)
  256.       balls%(1,2)=balls%(3,5)
  257.       balls%(3,5)=balls%(3,6)
  258.       balls%(3,6)=s%
  259.       @adept(1)
  260.       @adept(3)
  261.       @balls(5)
  262.     ENDIF
  263.     ' Andere Buttons
  264.     IF b%=11  ! Mischen
  265.       @do.it(RANDOM(10)+1)
  266.     ENDIF
  267.     IF b%=12  ! Ordnen
  268.       BMOVE VARPTR(ordnung%(1,1)),VARPTR(balls%(1,1)),intlen%*DIM?(balls%())
  269.       FOR j%=1 TO 4
  270.         @balls(j%)
  271.       NEXT j%
  272.     ENDIF
  273.     IF b%>=13 AND b%<=20  ! Grundmuster 1 bis 8
  274.       g%=grundmuster%+12
  275.       ' Rahmen um altes Grundmuster-Feld löschen u. neuen Rahmen zeichnen
  276.       COLOR 0
  277.       BOX button%(g%,1)+2,button%(g%,2)+2,button%(g%,3)-2,button%(g%,4)-2
  278.       COLOR 1
  279.       BOX button%(b%,1)+2,button%(b%,2)+2,button%(b%,3)-2,button%(b%,4)-2
  280.       grundmuster%=b%-12
  281.       @ball.init
  282.     ENDIF
  283.     IF b%=21  ! Editor
  284.       @editor
  285.     ENDIF
  286.     IF b%=22  ! Speichern
  287.       FILESELECT "\*.WCS","",f$
  288.       IF f$<>""
  289.         IF EXIST(f$)
  290.           ALERT 3,"Datei gibts -|Ok zum löschen ?",1,"Ja|Nein",s%
  291.         ELSE
  292.           s%=1
  293.         ENDIF
  294.         IF s%=1
  295.           VOID FRE(0)
  296.           BSAVE f$,VARPTR(balls%(1,1)),intlen%*DIM?(balls%())
  297.         ENDIF
  298.       ENDIF
  299.     ENDIF
  300.     IF b%=23  ! Laden
  301.       FILESELECT "\*.WCS","",f$
  302.       IF f$<>""
  303.         VOID FRE(0)
  304.         BLOAD f$,VARPTR(balls%(1,1))
  305.         BMOVE VARPTR(balls%(1,1)),VARPTR(ordnung%(1,1)),intlen%*DIM?(balls%())
  306.         FOR j%=1 TO 4
  307.           @balls(j%)
  308.         NEXT j%
  309.       ENDIF
  310.     ENDIF
  311.     IF b%=24  ! Ende
  312.       ALERT 0,"Wirklich Ende ?",1,"Ja|Nein",s%
  313.       IF s%=1
  314.         END
  315.       ENDIF
  316.     ENDIF
  317.   ENDIF
  318. RETURN
  319. PROCEDURE adept(n%)  ! alle Räder an # n% anpassen
  320.   IF n%=1
  321.     balls%(2,6)=balls%(1,3)
  322.     balls%(2,7)=balls%(1,2)
  323.     balls%(4,4)=balls%(1,1)
  324.     balls%(4,5)=balls%(1,8)
  325.   ENDIF
  326.   IF n%=2
  327.     balls%(1,3)=balls%(2,6)
  328.     balls%(1,2)=balls%(2,7)
  329.     balls%(3,5)=balls%(2,8)
  330.     balls%(3,4)=balls%(2,1)
  331.   ENDIF
  332.   IF n%=3
  333.     balls%(2,1)=balls%(3,4)
  334.     balls%(2,8)=balls%(3,5)
  335.     balls%(4,3)=balls%(3,6)
  336.     balls%(4,2)=balls%(3,7)
  337.   ENDIF
  338.   IF n%=4
  339.     balls%(1,8)=balls%(4,5)
  340.     balls%(1,1)=balls%(4,4)
  341.     balls%(3,6)=balls%(4,3)
  342.     balls%(3,7)=balls%(4,2)
  343.   ENDIF
  344. RETURN
  345. PROCEDURE editor
  346.   LOCAL bl$,x%,y%,j%,j1%,current%,bx%,by%,g%
  347.   current%=1
  348.   g%=grundmuster%+12
  349.   COLOR 0
  350.   BOX button%(g%,1)+2,button%(g%,2)+2,button%(g%,3)-2,button%(g%,4)-2
  351.   COLOR 1
  352.   grundmuster%=9
  353.   GET 551,0,640,400,bl$
  354.   DEFFILL 0
  355.   PBOX 551,0,640,400                    ! Editor-Bereich löschen
  356.   DEFTEXT 1,1,0,32
  357.   FOR j%=1 TO 6
  358.     TEXT 560,40*j%,MID$("EDITOR",j%,1)
  359.   NEXT j%
  360.   DEFTEXT 1,0,0,13
  361.   FOR j%=1 TO 24
  362.     DEFFILL 1,2,j%
  363.     PCIRCLE 620,j%*15,10                ! Auswahlkreise
  364.   NEXT j%
  365.   DEFLINE 1,3,0,1
  366.   LINE 600,current%*15,610,current%*15  ! Pfeil
  367.   DEFLINE 1,1,0,0
  368.   BOX 560,375,630,395                   ! "Fertig"-Button
  369.   DRAW 631,375 TO 631,396 TO 560,396    ! Schatten desselben
  370.   TEXT 563,390,64,"Fertig"
  371.   DO
  372.     REPEAT
  373.       x%=MOUSEX
  374.       y%=MOUSEY
  375.     UNTIL MOUSEK
  376.     EXIT IF x%>=560 AND y%>=375 AND x%<=630 AND y%<=395  ! Fertig-Button geklickt
  377.     IF x%>=600 AND y%<=370 ! Farbe angeklickt
  378.       DEFFILL 0
  379.       PBOX 600,current%*15-10,610,current%*15+10
  380.       current%=MAX(1,y%\15)
  381.       DEFLINE 1,3,0,1
  382.       LINE 600,current%*15,610,current%*15
  383.       DEFLINE 1,1,0,0
  384.     ELSE  ! Kreis angeklickt ?
  385.       FOR j%=1 TO 4
  386.         FOR j1%=1 TO 8
  387.           bx%=ballx%(j%,j1%)
  388.           by%=bally%(j%,j1%)
  389.           IF x%>=bx%-10 AND x%<=bx%+10 AND y%>=by%-10 AND y%<=by%+10  ! falls ja
  390.             DEFFILL 1,2,current%
  391.             PCIRCLE bx%,by%,10
  392.             balls%(j%,j1%)=current%
  393.             @adept(j%)
  394.           ENDIF
  395.         NEXT j1%
  396.       NEXT j%
  397.     ENDIF
  398.   LOOP
  399.   BMOVE VARPTR(balls%(1,1)),VARPTR(ordnung%(1,1)),intlen%*DIM?(balls%())
  400.   PUT 551,0,bl$
  401. RETURN
  402. PROCEDURE err
  403.   LOCAL i%,x$
  404.   INC ercnt%
  405.   RESTORE ertext
  406.   FOR j%=1 TO ercnt%
  407.     READ x$
  408.     IF x$=">>"
  409.       RESTORE ertext
  410.       READ x$
  411.       ercnt%=0
  412.     ENDIF
  413.   NEXT j%
  414.   ALERT 3,x$+"|Fehler # "+STR$(ERR),1,"Abbruch",i%
  415.   RESUME mainloop
  416. RETURN
  417. '
  418. '                                                                         DATAs
  419. '
  420. '
  421. circ.coord:
  422. DATA 320,120,400,200,320,280,240,200
  423. '
  424. ball.col.1:
  425. DATA 8,8,1,1,1,1,1,7
  426. DATA 3,3,3,3,3,1,8,8
  427. DATA 5,5,5,3,8,8,5,5
  428. DATA 7,5,8,8,7,7,7,7
  429. '
  430. ball.col.2:
  431. DATA 1,1,1,1,1,1,1,1
  432. DATA 2,8,8,8,8,1,1,1
  433. DATA 2,2,2,2,2,2,2,2
  434. DATA 8,2,2,1,1,8,8,8
  435. '
  436. ball.col.3:
  437. DATA 1,1,8,8,8,8,8,8
  438. DATA 8,8,8,8,8,8,1,1
  439. DATA 8,8,8,8,1,1,8,8
  440. DATA 8,8,1,1,8,8,8,8
  441. '
  442. ball.col.4:
  443. DATA 16,19,19,1,1,1,1,16
  444. DATA 13,2,2,2,2,19,19,13
  445. DATA 7,7,7,13,13,14,14,7
  446. DATA 8,14,14,16,16,8,8,8
  447. '
  448. ball.col.5:
  449. DATA 7,7,7,13,13,13,13,7
  450. DATA 7,13,13,13,13,7,7,7
  451. DATA 13,13,13,7,7,7,7,13
  452. DATA 13,7,7,7,7,13,13,13
  453. '
  454. ball.col.6:
  455. DATA 8,8,8,8,9,9,8,8
  456. DATA 8,8,24,24,8,8,8,8
  457. DATA 16,16,8,8,8,8,8,8
  458. DATA 8,8,8,8,8,8,22,22
  459. '
  460. ball.col.7:
  461. DATA 13,13,8,12,12,12,12,8
  462. DATA 8,7,7,7,7,8,13,13
  463. DATA 22,22,22,8,13,13,8,22
  464. DATA 5,8,13,13,8,5,5,5,5
  465. '
  466. ball.col.8:
  467. DATA 8,8,8,8,8,8,8,11
  468. DATA 11,8,8,8,8,8,8,8
  469. DATA 11,11,11,11,8,11,11,11
  470. DATA 11,11,11,8,11,11,11,11
  471. '
  472. buttons:
  473. DATA 278,15,318,35,308,25,288,25
  474. DATA 322,15,362,35,332,25,352,25
  475. DATA 485,158,505,198,495,189,495,168
  476. DATA 485,202,505,242,495,212,495,232
  477. DATA 322,365,362,385,332,375,352,375
  478. DATA 278,365,318,385,308,375,288,375
  479. DATA 130,202,150,242,140,212,140,232
  480. DATA 130,158,150,198,140,188,140,168
  481. DATA 465,15,505,55,475,25,495,45
  482. DATA 130,345,170,385,140,355,160,375
  483. DATA 5,60,65,80,7,75,Mischen
  484. DATA 5,120,65,140,7,135,Ordnen
  485. DATA 5,200,25,220,12,215,1
  486. DATA 30,200,50,220,37,215,2
  487. DATA 55,200,75,220,62,215,3
  488. DATA 5,225,25,245,12,240,4
  489. DATA 30,225,50,245,37,240,5
  490. DATA 55,225,75,245,62,240,6
  491. DATA 5,250,25,270,12,265,7
  492. DATA 30,250,50,270,37,265,8
  493. DATA 55,250,75,270,62,265,E
  494. DATA 5,290,65,310,7,305,Speichern
  495. DATA 5,315,65,335,7,330,Laden
  496. DATA 5,365,65,385,7,380,Ende
  497. '
  498. ertext:
  499. DATA Oh nein! Welch Schrecken!,Es schüttelt mich grausam ...,Was ist das ?
  500. DATA Weh mir !,Irgendwas stimmt nicht ...,Pass doch auf Mann !
  501. DATA Ich glaub ich spinn -,Du hast es geschafft !,>>
  502. '
  503. '
  504. '                                                                       The End
  505.